home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MATH
/
MATHLIB2
/
PCOMPLEX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-10-14
|
12KB
|
433 lines
Unit PCOMPLEX;
(* Bibliotheque mathematique pour type complexe *)
(* Version a fonctions et pointeurs *)
(* JD GAYRARD mai 95 *)
(* This library is based on functions instead of procedures.
To allow a function to return complex type, the trick is
is to use a pointer on the result of the function. All
functions are of Pcomplex type (^complexe).
In the main program the function computation is accessed
by z := function_name(param1, param2)^ *)
{$G+}
{$N+}
{$E-}
interface
uses MATHLIB, HYPERBOL;
const author = 'GAYRARD J-D';
version = 'ver 0.0 - 05/95';
type complexe = record
reel : float;
imag : float
end;
pcomplexe = ^complexe;
const _i : complexe = (reel : 0.0; imag : 1.0);
_0 : complexe = (reel : 0.0; imag : 0.0);
var result : complexe; { all functions result points on this varaible }
(* quatre operations : +, -, * , / *)
function cadd (z1, z2 : complexe) : pcomplexe; (* addition *)
function csub (z1, z2 : complexe) : pcomplexe; (* soustraction *)
function cmul (z1, z2 : complexe) : pcomplexe; (* multiplication *)
function cdiv (znum, zden : complexe) : pcomplexe; (* division znum / zden *)
(* fonctions complexes particulieres *)
function cneg (z : complexe) : pcomplexe; (* negatif *)
function ccong (z : complexe) : pcomplexe; (* conjuge *)
function crcp (z : complexe) : pcomplexe; (* inverse *)
function ciz (z : complexe) : pcomplexe; (* multiplication par i *)
function c_iz (z : complexe) : pcomplexe; (* multiplication par -i *)
function czero : pcomplexe; (* return zero *)
(* fonctions complexes a retour non complexe *)
function cmod (z : complexe) : float; (* module *)
function cequal (z1, z2 : complexe) : boolean; (* compare deux complexes *)
function carg (z : complexe) : float; (* argument : a / z = p.e^ia *)
(* fonctions elementaires *)
function cexp (z : complexe) : pcomplexe; (* exponantielle *)
function cln (z : complexe) : pcomplexe; (* logarithme naturel *)
function csqrt (z : complexe) : pcomplexe; (* racine carre *)
(* fonctions trigonometrique directe *)
function ccos (z : complexe) : pcomplexe; (* cosinus *)
function csin (z : complexe) : pcomplexe; (* sinus *)
function ctg (z : complexe) : pcomplexe; (* tangente *)
(* fonctions trigonometriques inverses *)
function carc_cos (z : complexe) : pcomplexe; (* arc cosinus *)
function carc_sin (z : complexe) : pcomplexe; (* arc sinus *)
function carc_tg (z : complexe) : pcomplexe; (* arc tangente *)
(* fonctions trigonometrique hyperbolique *)
function cch (z : complexe) : pcomplexe; (* cosinus hyperbolique *)
function csh (z : complexe) : pcomplexe; (* sinus hyperbolique *)
function cth (z : complexe) : pcomplexe; (* tangente hyperbolique *)
(* fonctions trigonometrique hyperbolique inverse *)
function carg_ch (z : complexe) : pcomplexe; (* arc cosinus hyperbolique *)
function carg_sh (z : complexe) : pcomplexe; (* arc sinus hyperbolique *)
function carg_th (z : complexe) : pcomplexe; (* arc tangente hyperbolique *)
implementation
(* quatre operations de base +, -, * , / *)
function cadd (z1, z2 : complexe) : pcomplexe;
(* addition : r := z1 + z2 *)
begin
result.reel := z1.reel + z2.reel;
result.imag := z1.imag + z2.imag;
cadd := @result
end;
function csub (z1, z2 : complexe) : pcomplexe;
(* soustraction : r := z1 - z2 *)
begin
result.reel := z1.reel - z2.reel;
result.imag := z1.imag - z2.imag;
csub := @result
end;
function cmul (z1, z2 : complexe) : pcomplexe;
(* multiplication : r := z1 * z2 *)
begin
result.reel := (z1.reel * z2.reel) - (z1.imag * z2.imag);
result.imag := (z1.reel * z2.imag) + (z1.imag * z2.reel);
cmul := @result
end;
function cdiv (znum, zden : complexe) : pcomplexe;
(* division : r := znum / zden *)
var denom : float;
begin
with zden do denom := (reel * reel) + (imag * imag);
if denom = 0.0
then begin
writeln('******** function Cdiv ********');
writeln('******* DIVISION PAR ZERO ******');
halt
end
else begin
result.reel := ((znum.reel * zden.reel) + (znum.imag * zden.imag)) / denom;
result.imag := ((znum.imag * zden.reel) - (znum.reel * zden.imag)) / denom
end;
cdiv := @result
end;
(* fonctions complexes particulieres *)
function cneg (z : complexe) : pcomplexe;
(* negatif : r = - z *)
begin
result.reel := - z.reel;
result.imag := - z.imag;
cneg := @result
end;
function cmod (z : complexe): float;
(* module : r = |z| *)
begin
with z do cmod := sqrt((reel * reel) + (imag * imag))
end;
function carg (z : complexe): float;
(* argument : 0 / z = p ei0 *)
begin
carg := arctan2(z.reel, z.imag)
end;
function ccong (z : complexe) : pcomplexe;
(* conjuge : z := x + i.y alors r = x - i.y *)
begin
result.reel := z.reel;
result.imag := - z.imag;
ccong := @result
end;
function crcp (z : complexe) : pcomplexe;
(* inverse : r := 1 / z *)
var denom : float;
begin
with z do denom := (reel * reel) + (imag * imag);
if denom = 0.0
then begin
writeln('******** function Crcp ********');
writeln('******* DIVISION PAR ZERO ******');
halt
end
else begin
result.reel := z.reel / denom;
result.imag := - z.imag / denom
end;
crcp := @result
end;
function ciz (z : complexe) : pcomplexe;
(* multiplication par i *)
(* z = x + i.y , r = i.z = - y + i.x *)
begin
result.reel := - z.imag;
result.imag := z.reel;
ciz := @result
end;
function c_iz (z : complexe) : pcomplexe;
(* multiplication par -i *)
(* z = x + i.y , r = i.z = y - i.x *)
begin
result.reel := z.imag;
result.imag := - z.reel;
c_iz := @result
end;
function czero : pcomplexe;
(* return a zero complexe *)
begin
result.reel := 0.0;
result.imag := 0.0;
czero := @result
end;
function cequal (z1, z2 : complexe) : boolean;
(* retourne TRUE si z1 = z2 *)
begin
cequal := (z1.reel = z2.reel) and (z1.imag = z2.imag)
end;
(* fonctions elementaires *)
function cexp (z : complexe) : pcomplexe;
(* exponantielle : r := exp(z) *)
(* exp(x + iy) = exp(x).exp(iy) = exp(x).[cos(y) + i sin(y)] *)
var expz : float;
begin
expz := exp(z.reel);
result.reel := expz * cos(z.imag);
result.imag := expz * sin(z.imag);
cexp := @result
end;
function cln (z : complexe) : pcomplexe;
(* logarithme naturel : r := ln(z) *)
(* ln( p exp(i0)) = ln(p) + i0 + 2kpi *)
var modz : float;
begin
with z do modz := (reel * reel) + (imag * imag);
if modz = 0.0
then begin
writeln('********* function Cln *********');
writeln('****** LOGARITHME DE ZERO ******');
halt
end
else begin
result.reel := ln(modz);
result.imag := arctan2(z.reel, z.imag);
cln := @result
end
end;
function csqrt (z : complexe) : pcomplexe;
(* racine carre : r := sqrt(z) *)
var root, q : float;
begin
if (z.reel <> 0.0) or (z.imag <> 0.0)
then begin
root := sqrt(0.5 * (abs(z.reel) + cmod(z)));
q := z.imag / (2.0 * root);
if z.reel >= 0.0
then with result do
begin
reel := root;
imag := q
end
else if z.imag < 0.0
then with result do
begin
reel := - q;
imag := - root
end
else with result do
begin
reel := q;
imag := root
end
end
else result := z;
csqrt := @result
end;
(* fonctions trigonometriques directes *)
function ccos (z : complexe) : pcomplexe;
(* cosinus complexe *)
(* cos(x+iy) = cos(x).cos(iy) - sin(x).sin(iy) *)
(* cos(ix) = ch(x) et sin(ix) = i.sh(x) *)
begin
result.reel := cos(z.reel) * ch(z.imag);
result.imag := - sin(z.reel) * sh(z.imag);
ccos := @result
end;
function csin (z : complexe) : pcomplexe;
(* sinus complexe *)
(* sin(x+iy) = sin(x).cos(iy) + cos(x).sin(iy) *)
(* cos(ix) = ch(x) et sin(ix) = i.sh(x) *)
begin
result.reel := sin(z.reel) * ch(z.imag);
result.imag := cos(z.reel) * sh(z.imag);
csin := @result
end;
function ctg (z : complexe) : pcomplexe;
(* tangente *)
var ccosz, temp : complexe;
begin
ccosz := ccos(z)^;
if (ccosz.reel = 0.0) and (ccosz.imag = 0.0)
then begin
writeln('********* function Ctg *********');
writeln('******* DIVISION PAR ZERO ******');
halt
end
else begin
temp := csin(z)^;
result := cdiv(temp, ccosz)^;
ctg := @result
end
end;
(* fonctions trigonometriques inverses *)
function carc_cos (z : complexe) : pcomplexe;
(* arc cosinus complexe *)
(* arccos(z) = -i.argch(z) *)
begin
z := carg_ch(z)^;
result := c_iz(z)^;
carc_cos := @result
end;
function carc_sin (z : complexe) : pcomplexe;
(* arc sinus complexe *)
(* arcsin(z) = -i.argsh(i.z) *)
begin
z := ciz(z)^;
z := carg_sh(z)^;
result := c_iz(z)^;
carc_sin := @result
end;
function carc_tg (z : complexe) : pcomplexe;
(* arc tangente complexe *)
(* arctg(z) = -i.argth(i.z) *)
begin
z := ciz(z)^;
z := carg_th(z)^;
result := c_iz(z)^;
carc_tg := @result
end;
(* fonctions trigonometriques hyperboliques *)
function cch (z : complexe) : pcomplexe;
(* cosinus hyperbolique *)
(* ch(x+iy) = ch(x).ch(iy) + sh(x).sh(iy) *)
(* ch(iy) = cos(y) et sh(iy) = i.sin(y) *)
begin
result.reel := ch(z.reel) * cos(z.imag);
result.imag := sh(z.reel) * sin(z.imag);
cch := @result
end;
function csh (z : complexe) : pcomplexe;
(* sinus hyperbolique *)
(* sh(x+iy) = sh(x).ch(iy) + ch(x).sh(iy) *)
(* ch(iy) = cos(y) et sh(iy) = i.sin(y) *)
begin
result.reel := sh(z.reel) * cos(z.imag);
result.imag := ch(z.reel) * sin(z.imag);
csh := @result
end;
function cth (z : complexe) : pcomplexe;
(* tangente hyperbolique complexe *)
(* th(x) = sh(x) / ch(x) *)
(* ch(x) > 1 qq x *)
var temp : complexe;
begin
temp := cch(z)^;
z := csh(z)^;
result := cdiv(z, temp)^;
cth := @result
end;
(* fonctions trigonometriques hyperboliques inverses *)
function carg_ch (z : complexe) : pcomplexe;
(* arg cosinus hyperbolique *)
(* _________ *)
(* argch(z) = -/+ ln(z + i.V 1 - z.z) *)
var temp : complexe;
begin
with temp do begin
reel := 1 - z.reel * z.reel + z.imag * z.imag;
imag := - 2 * z.reel * z.imag
end;
temp := csqrt(temp)^;
temp := ciz(temp)^;
temp := cadd(temp, z)^;
temp := cln(temp)^;
result := cneg(temp)^;
carg_ch := @result
end;
function carg_sh (z : complexe) : pcomplexe;
(* arc sinus hyperbolique *)
(* ________ *)
(* argsh(z) = ln(z + V 1 + z.z) *)
var temp : complexe;
begin
with temp do begin
reel := 1 + z.reel * z.reel - z.imag * z.imag;
imag := 2 * z.reel * z.imag
end;
temp := csqrt(temp)^;
temp := cadd(temp, z)^;
result := cln(temp)^;
carg_sh := @result
end;
function carg_th (z : complexe) : pcomplexe;
(* arc tangente hyperbolique *)
(* argth(z) = 1/2 ln((z + 1) / (1 - z)) *)
var temp : complexe;
begin
with temp do begin
reel := 1 + z.reel;
imag := z.imag
end;
with result do begin
reel := 1 - reel;
imag := - imag
end;
result := cdiv(temp, result)^;
with result do begin
reel := 0.5 * reel;
imag := 0.5 * imag
end;
carg_th := @result
end;
end.